home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1997
/
HAM Radio 1997.iso
/
vcls
/
prnmain
/
prnmain.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-08
|
33KB
|
1,115 lines
{******* prnMain.pas *******}
unit Prnmain;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Printers;
const
HeaderLines = 5; { Number of allowable header lines }
FooterLines = 5; { Number of allowable footer lines }
Columns = 20; { Number of allowable columns }
type
THeaderRecord = Record
Text: String[240]; { Header text }
YPosition: Single; { Inches from the top }
Alignment: Integer; { 0:Left 1:Center 2:Right }
FontName: String[80]; { Font name }
FontSize: Integer; { Font size }
FontStyle: TFontStyles; { Font style }
End;
TFooterRecord = Record
Text: String[240]; { Footer text }
YPosition: Single; { Inches from the top }
Alignment: Integer; { 0:Left 1:Center 2:Right }
FontName: String[80]; { Font name }
FontSize: Integer; { Font size }
FontStyle: TFontStyles; { Font style }
End;
THeaderCoordinates = Record
XTop: Single;
YTop: Single;
XBottom: Single;
YBottom: Single;
Boxed: Boolean;
Shading: Word;
LineWidth: Word;
End;
TFooterCoordinates = Record
XTop: Single;
YTop: Single;
XBottom: Single;
YBottom: Single;
Boxed: Boolean;
Shading: Word;
LineWidth: Word;
End;
TPageNumberRecord = Record
YPosition: Single;
Text: String[240];
Alignment: Word;
FontName: String[80];
FontSize: Word;
FontStyle: TFontStyles;
End;
TColumnInformationRecord = Record
XPosition: Single;
Length: Single;
End;
TPrintObject = class
private
TopMargin: Integer; { Top margin in pixels }
BottomMargin: Integer; { Bottom margin in pixels }
LeftMargin: Integer; { Left margin in pixels }
RightMargin: Integer; { Right margin in pixels }
PixelsPerInchVertical: Integer; { Number of pixels per inch along Y axis }
PixelsPerInchHorizontal: Integer; { Number of pixels per inch along X axis }
TotalPageWidthPixels: Integer; { Full width of page in pixels - includes gutters }
TotalPageHeightPixels: Integer; { Full height of page in pixels - includes gutters }
TotalPageHeightInches: Single; { Height of page in inches }
TotalPageWidthInches: Single; { Width of page in inches }
GutterLeft: Integer; { Unprintable area on left }
GutterRight: Integer; { Unprintable area on right }
GutterTop: Integer; { Unprintable area on top }
GutterBottom: Integer; { Unprintable area on bottom }
DetailTop: Single; { Inches from the top where the detail section starts }
DetailBottom: Single; { Inches from the top where the detail section ends }
LastYPosition: Single; { The Y position where the last write occurred }
AutoPaging: Boolean; { Are new pages automatically generated? }
CurrentTab: Single; { The value of the current tab }
CurrentFontName: String[30];
CurrentFontSize: Integer;
CurrentFontStyle: TFontStyles;
TextMetrics: TTextMetric;
Header: Array[1..HeaderLines] of THeaderRecord;
Footer: Array[1..FooterLines] of TFooterRecord;
ColumnInformation: Array[1..Columns] of TColumnInformationRecord;
PageNumber: TPageNumberRecord;
HeaderCoordinates: THeaderCoordinates;
FooterCoordinates: TFooterCoordinates;
function CalculateLineHeight: Integer;
function InchesToPixelsHorizontal( Inches: Single ): Integer;
function InchesToPixelsVertical( Inches: Single ): Integer;
function PixelsToInchesHorizontal( Pixels: Integer ): Single;
function PixelsToInchesVertical( Pixels: Integer ): Single;
function LinesToPixels( Line:Integer ): Integer;
procedure CalculateMeasurements;
procedure _DrawBox( XTop:Word; YTop:Word; XBottom:Word; YBottom:Word; LineWidth:Word; Shading:Word );
public
procedure Start;
procedure Quit;
procedure Abort;
procedure SetMargins( Top:Single; Bottom:Single; Left:Single; Right:Single );
procedure SetFontInformation( Name:String; Size:Word; Style: TFontStyles );
procedure WriteLine( X:Single; Y:Single; Text:String );
procedure WriteLineRight( Y:Single; Text:String );
procedure WriteLineCenter( Y:Single; Text:String );
procedure WriteLineColumnRight( ColumnNumber:Word; Y:Single; Text:String );
procedure WriteLineColumnCenter( ColumnNumber:Word; Y:Single; Text:String );
procedure DrawLine( TopX:Single; TopY:Single; BottomX:Single; BottomY:Single; LineWidth:Word );
procedure SetLineWidth( Width:Word );
function GetLineWidth: Word;
procedure SetTab( Inches:Single );
procedure NewPage;
function GetLinesPerPage: Integer;
procedure GetPixelsPerInch( var X:Word; var Y:Word );
procedure GetPixelsPerPage( var X:Word; var Y:Word );
procedure GetGutter( var Top:Word; var Bottom:Word; var Left:Word; var Right:Word );
function GetTextWidth( Text:String ): Integer;
function GetLineHeightPixels: Word;
function GetLineHeightInches: Single;
function GetPageNumber:Integer;
function GetColumnsPerLine: Integer;
procedure SetOrientation( Orient: TPrinterOrientation );
procedure SetHeaderInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word;
FontName:String; FontSize: Word; FontStyle: TFontStyles );
procedure SetFooterInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word;
FontName:String; FontSize: Word; FontStyle: TFontStyles );
procedure WriteHeader;
procedure WriteFooter;
procedure SaveCurrentFont;
procedure RestoreCurrentFont;
procedure SetDetailTopBottom( Top: Single; Bottom: Single );
procedure SetAutoPaging( Value: Boolean );
procedure SetPageNumberInformation( YPosition:Single; Text:String; Alignment:Word; FontName:String;
FontSize:Word; FontStyle:TFontStyles );
procedure WritePageNumber;
procedure WriteLineColumn( ColumnNumber:Word; Y:Single; Text:String );
procedure DrawBox( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word );
procedure DrawBoxShaded( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word; Shading:Word );
procedure SetHeaderDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
Boxed: Boolean; LineWidth:Word; Shading:Word );
procedure SetFooterDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
Boxed: Boolean; LineWidth:Word; Shading:Word );
procedure CreateColumn( Number:Word; XPosition:Single; Length:Single );
procedure SetYPosition( YPosition:Single );
function GetYPosition: Single;
procedure NextLine;
function GetLinesLeft: Word;
function GetLinesInDetailArea: Word;
procedure SetTopOfPage;
procedure NewLines( Number:Word );
function GetFontName: String;
function GetFontSize: Word;
End;
implementation
procedure TPrintObject.Start;
{ This function MUST be called first before any other printing function }
var
Top,Bottom,Left,Right: Single;
I: Integer;
Begin
Printer.BeginDoc;
AutoPaging := True;
CalculateMeasurements;
PageNumber.Text := '';
Top := PixelsToInchesVertical( GutterTop );
Bottom := PixelsToInchesVertical( GutterBottom );
Left := PixelsToInchesHorizontal( GutterLeft );
Right := PixelsToInchesHorizontal( GutterRight );
SetMargins( Top,Bottom,Left,Right );
For I := 1 To HeaderLines Do
Header[I].Text := '';
HeaderCoordinates.Boxed := False;
HeaderCoordinates.Shading := 0;
For I := 1 To FooterLines Do
Footer[I].Text := '';
FooterCoordinates.Boxed := False;
FooterCoordinates.Shading := 0;
CurrentTab := 0.0;
LastYPosition := 0.0;
End;
procedure TPrintObject.Quit;
{ 'Quit' must always be called when printing is completed }
Begin
WriteHeader;
WriteFooter;
WritePageNumber;
Printer.EndDoc
End;
procedure TPrintObject.SetMargins( Top:Single; Bottom:Single; Left:Single; Right:Single );
{ Set the top, bottom, left and right margins in inches }
var
Value: Single;
Buffer: String;
Begin
{ If the sum of the left and right margins exceeds the width of the page,
set the left margin to the value of 'GutterLeft' and set the right
margin to the value of 'GutterRight' }
If ( Left + Right >= TotalPageWidthInches ) Then
Begin
Left := GutterLeft;
Right := GutterRight;
End;
If ( Left <= 0 ) Then
Left := GutterLeft;
If ( Right <= 0 ) Then
Right := GutterRight;
{ If the sum of the top and bottom margins exceeds the height of the
page, set the top margin to the value of 'GutterTop' and set the
bottom margin to the value of 'GutterBottom' }
If ( Top + Bottom >= TotalPageHeightInches ) Then
Begin
Top := GutterTop;
Bottom := GutterBottom;
End;
If ( Top <= 0 ) Then
Top := GutterTop;
If ( Bottom <= 0 ) Then
Bottom := GutterBottom;
{ Convert everything to pixels }
TopMargin := InchesToPixelsVertical( Top );
If ( TopMargin < GutterTop ) Then
TopMargin := GutterTop;
BottomMargin := InchesToPixelsVertical( Bottom );
If ( BottomMargin < GutterBottom ) Then
BottomMargin := GutterBottom;
LeftMargin := InchesToPixelsHorizontal( Left );
If ( LeftMargin < GutterLeft ) Then
LeftMargin := GutterLeft;
RightMargin := InchesToPixelsHorizontal( Right );
If ( RightMargin < GutterRight ) Then
RightMargin := GutterRight;
End;
procedure TPrintObject.WriteLine( X:Single; Y:Single; Text:String );
{ Write some text. The parameters represent inches from the left ('X')
and top ('Y') margins. }
var
XPixels: Integer;
YPixels: Integer;
Begin
{ How many pixels are there in the inches represented by 'X'? }
If ( X >= 0.0 ) Then
XPixels := InchesToPixelsHorizontal( X )
Else
XPixels := LeftMargin;
If ( XPixels < GutterLeft ) Then
XPixels := GutterLeft;
{ If there is a tab set, increase 'XPixels' by the amount of the tab }
If ( CurrentTab > 0.0 ) Then
Inc( XPixels,InchesToPixelsHorizontal(CurrentTab) );
{ How many pixels are there in the inches represented by 'Y'? }
If ( Y > -0.01 ) Then
{ Printing will occur at an absolute location from the top of the
page. }
Begin
YPixels := InchesToPixelsVertical( Y );
If ( YPixels < GutterTop ) Then
YPixels := GutterTop;
If ( YPixels > TotalPageHeightPixels ) Then
YPixels := TotalPageHeightPixels - GutterBottom;
LastYPosition := Y;
End;
If ( Y = -1.0 ) Then
{ Write the text at the next line }
Begin
If ( AutoPaging = True ) Then
Begin
{ If the next line we're going to write to exceeds beyond the
bottom of the detail section, issue a new page }
If ( LastYPosition + GetLineHeightInches > DetailBottom ) Then
NewPage;
End;
YPixels := InchesToPixelsVertical( LastYPosition + GetLineHeightInches );
LastYPosition := LastYPosition + GetLineHeightInches;
End;
If ( Y = -2.0 ) Then
{ Write the text on the current line }
YPixels := InchesToPixelsVertical( LastYPosition );
Printer.Canvas.TextOut( XPixels-GutterLeft,YPixels-GutterTop,Text );
End;
procedure TPrintObject.WriteLineColumn( ColumnNumber:Word; Y:Single; Text:String );
{ Write text, left aligned against the column represented by
'ColumnInformation[ColumnNumber]' }
Begin
WriteLine( ColumnInformation[ColumnNumber].XPosition,Y,Text );
End;
procedure TPrintObject.WriteLineColumnRight( ColumnNumber:Word; Y:Single; Text:String );
{ Write text, right aligned against the column represented by
'ColumnInformation[ColumnNumber]' }
var
PixelLength: Word;
StartPixel: Word;
Begin
{ How many pixels does the text in 'Text' require? }
PixelLength := Printer.Canvas.TextWidth( Text );
{ Calculate where printing should start }
StartPixel := InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].XPosition +
ColumnInformation[ColumnNumber].Length ) - PixelLength;
SetTab( 0.0 );
WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
SetTab( CurrentTab );
End;
procedure TPrintObject.WriteLineRight( Y:Single; Text:String );
{ Print a line of text right justified 'Y' inches from the top }
var
PixelLength: Word;
StartPixel: Word;
Begin
{ How many pixels does the text in 'Text' require? }
PixelLength := Printer.Canvas.TextWidth( Text );
{ Calculate where printing should start }
StartPixel := (TotalPageWidthPixels-GutterLeft-GutterRight) - PixelLength;
SetTab( 0.0 );
WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
SetTab( CurrentTab );
End;
procedure TPrintObject.WriteLineCenter( Y:Single; Text:String );
{ Print a line of text centered at Y inches from the top }
var
PixelLength: Integer;
StartPixel: Integer;
Begin
{ How many pixels does the text in 'Text' require? }
PixelLength := Printer.Canvas.TextWidth( Text );
{ Calculate where printing should start }
StartPixel := ((GutterLeft+(TotalPageWidthPixels-GutterRight)) Div 2) - (PixelLength Div 2);
SetTab( 0.0 );
WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
SetTab( CurrentTab );
End;
procedure TPrintObject.WriteLineColumnCenter( ColumnNumber:Word; Y:Single; Text:String );
{ Print a line of text centered within the column number represented by
'ColumnNumber', at Y inches from the top }
var
PixelLength: Integer;
StartPixel: Integer;
Pixels: Integer;
Begin
{ How many pixels does the text in 'Text' require? }
PixelLength := Printer.Canvas.TextWidth( Text );
{ Calculate where printing should start }
Pixels := InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].Length );
StartPixel := (InchesToPixelsHorizontal( ColumnInformation[ColumnNumber].Length ) Div 2) +
InchesToPixelsHorizontal(ColumnInformation[ColumnNumber].XPosition) - (PixelLength Div 2);
SetTab( 0.0 );
WriteLine( PixelsToInchesHorizontal(StartPixel),Y,Text );
SetTab( CurrentTab );
End;
procedure TPrintObject.DrawLine( TopX:Single; TopY:Single; BottomX:Single; BottomY:Single; LineWidth:Word );
{ Draw a line beginning at a particular X,Y coordinate and ending at a
particular X,Y coordinate. }
var
TopXPixels, BottomXPixels, TopYPixels, BottomYPixels: Integer;
Begin
TopXPixels := InchesToPixelsHorizontal( TopX );
BottomXPixels := InchesToPixelsHorizontal( BottomX );
TopYPixels := InchesToPixelsVertical( TopY );
BottomYPixels := InchesToPixelsVertical( BottomY );
Dec( TopXPixels,GutterLeft );
Dec( BottomXPixels,GutterLeft );
Dec( TopYPixels,GutterTop );
Dec( BottomYPixels,GutterTop );
Printer.Canvas.Pen.Width := LineWidth;
Printer.Canvas.MoveTo( TopXPixels,TopYPixels );
Printer.Canvas.LineTo( BottomXPixels,BottomYPixels );
End;
procedure TPrintObject.SetFontInformation( Name:String; Size:Word; Style: TFontStyles );
{ Change the current font information }
Begin
Printer.Canvas.Font.Name := Name;
Printer.Canvas.Font.Size := Size;
Printer.Canvas.Font.Style := Style;
CalculateMeasurements;
End;
function TPrintObject.GetFontName: String;
{ Return the current font name }
Begin
Result := Printer.Canvas.Font.Name;
End;
function TPrintObject.GetFontSize: Word;
{ Return the current font size }
Begin
Result := Printer.Canvas.Font.Size;
End;
procedure TPrintObject.SetOrientation( Orient: TPrinterOrientation );
Begin
Printer.Orientation := Orient;
CalculateMeasurements;
End;
function TPrintObject.CalculateLineHeight: Integer;
{ Calculate the height of a line plus the normal amount of space between
each line }
Begin
Result := TextMetrics.tmHeight + TextMetrics.tmExternalLeading;
End;
procedure TPrintObject.NewPage;
{ Issue a new page }
Begin
WriteHeader;
WriteFooter;
WritePageNumber;
LastYPosition := DetailTop - GetLineHeightInches;
Printer.NewPage;
End;
function TPrintObject.GetPageNumber;
{ Return the current page number }
Begin
Result := Printer.PageNumber;
End;
function TPrintObject.GetTextWidth( Text:String ): Integer;
{ Return the width of the text contained in 'Text' in pixels }
Begin
Result := Printer.Canvas.TextWidth( Text );
End;
function TPrintObject.GetLineHeightPixels: Word;
Begin
Result := CalculateLineHeight;
End;
function TPrintObject.GetLineHeightInches: Single;
Begin
Result := PixelsToInchesVertical( GetLineHeightPixels );
End;
procedure TPrintObject._DrawBox( XTop:Word; YTop:Word; XBottom:Word; YBottom:Word; LineWidth:Word; Shading:Word );
{ The low level routine which actually draws the box and shades it as
desired. The paramaters are in pixels and not inches. }
Begin
Printer.Canvas.Pen.Width := LineWidth;
Printer.Canvas.Brush.Color := RGB( Shading,Shading,Shading );
Printer.Canvas.Rectangle( XTop,YTop,XBottom,YBottom );
End;
procedure TPrintObject.DrawBox( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word );
{ Draw a box at the X,Y coordinates passed in the parameters }
var
BLinePixels,BColPixels,ELinePixels,EColPixels: Integer;
Begin
BLinePixels := InchesToPixelsVertical( YTop ) - GutterTop;
ELinePixels := InchesToPixelsVertical( YBottom ) - GutterTop;
BColPixels := InchesToPixelsHorizontal( XTop ) - GutterLeft;
EColPixels := InchesToPixelsHorizontal( XBottom ) - GutterLeft;
_DrawBox( BColPixels,BLinePixels,EColPixels,ELinePixels,LineWidth,255 );
End;
procedure TPrintObject.DrawBoxShaded( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single; LineWidth:Word; Shading:Word );
{ Draw a box at the X,Y coordinates passed in the parameters }
var
BLinePixels,BColPixels,ELinePixels,EColPixels: Integer;
Begin
BLinePixels := InchesToPixelsVertical( YTop ) - GutterTop;
ELinePixels := InchesToPixelsVertical( YBottom ) - GutterTop;
BColPixels := InchesToPixelsHorizontal( XTop ) - GutterLeft;
EColPixels := InchesToPixelsHorizontal( XBottom ) - GutterLeft;
_DrawBox( BColPixels,BLinePixels,EColPixels,ELinePixels,LineWidth,Shading );
End;
function TPrintObject.GetLinesPerPage: Integer;
{ Return the number of lines on the entire page }
Begin
Result := (TotalPageHeightPixels - GutterTop - GutterBottom) Div CalculateLineHeight;
End;
function TPrintObject.GetLinesInDetailArea: Word;
{ Return the number of lines in the detail area }
Begin
Result := InchesToPixelsVertical( DetailBottom - DetailTop ) Div CalculateLineHeight;
End;
procedure TPrintObject.GetPixelsPerInch( var X:Word; var Y:Word );
Begin
X := PixelsPerInchHorizontal;
Y := PixelsPerInchVertical;
End;
procedure TPrintObject.GetPixelsPerPage( var X:Word; var Y:Word );
Begin
X := TotalPageWidthPixels - GutterLeft - GutterRight;
Y := TotalPageHeightPixels - GutterTop - GutterBottom;
End;
procedure TPrintObject.GetGutter( var Top:Word; var Bottom:Word; var Left:Word; var Right:Word );
Begin
Top := GutterTop;
Bottom := GutterBottom;
Left := GutterLeft;
Right := GutterRight;
End;
procedure TPrintObject.Abort;
Begin
Printer.Abort;
End;
function TPrintObject.GetColumnsPerLine: Integer;
{ How many columns are there in a Line? }
var
Pixels: Integer;
Begin
Pixels := TotalPageWidthPixels - GutterLeft - GutterRight;
Result := Pixels Div Printer.Canvas.TextWidth( 'B' );
End;
function TPrintObject.InchesToPixelsHorizontal( Inches: Single ): Integer;
{ Convert the horizontal inches represented in 'Inches' to pixels }
var
Value: Single;
Buffer: String;
I: Integer;
Begin
Value := Inches * PixelsPerInchHorizontal;
Buffer := FloatToStr( Value );
{ If there is a decimal point in 'Buffer', remove it. }
I := 1;
While( (Buffer[I] <> '.') And (I <= Length(Buffer)) ) Do
Inc( I );
Buffer[0] := Chr( I-1 );
Result := StrToInt( Buffer );
End;
function TPrintObject.InchesToPixelsVertical( Inches: Single ): Integer;
{ Convert the vertical inches represented in 'Inches' to pixels }
var
Value: Single;
Buffer: String;
I: Integer;
Begin
Value := Inches * PixelsPerInchVertical;
Buffer := FloatToStr( Value );
{ If there is a decimal point in 'Buffer', remove it. }
I := 1;
While( (Buffer[I] <> '.') And (I <= Length(Buffer)) ) Do
Inc( I );
Buffer[0] := Chr( I-1 );
Result := StrToInt( Buffer );
End;
function TPrintObject.PixelsToInchesHorizontal( Pixels: Integer ): Single;
Begin
Result := Pixels / PixelsPerInchHorizontal;
End;
function TPrintObject.PixelsToInchesVertical( Pixels: Integer ): Single;
Begin
Result := Pixels / PixelsPerInchVertical;
End;
function TPrintObject.LinesToPixels( Line:Integer ): Integer;
{ Calculate the number of vertical pixels in 'Line' }
Begin
If ( Line <= 0 ) Then
Line := 1;
Result := (Line-1) * CalculateLineHeight;
End;
procedure TPrintObject.SetLineWidth( Width:Word );
Begin
Printer.Canvas.Pen.Width := Width;
End;
function TPrintObject.GetLineWidth: Word;
Begin
Result := Printer.Canvas.Pen.Width;
End;
procedure TPrintObject.CalculateMeasurements;
{ Calculate some necessary measurements. Thanks to Robert Fabiszak
CompuServe: 70304,2047 for the Escape() Windows API calls. }
var
pt: TPoint;
Begin
{ Call the Windows API function GetTextMetrics() to get the specifics
of the particular font. }
GetTextMetrics( Printer.Canvas.Handle,TextMetrics );
{ Calculate the number of pixels per inch vertical and horizontal.
'GetDeviceCaps' is a Windows API call. }
PixelsPerInchVertical := GetDeviceCaps( Printer.Handle,LOGPIXELSY );
PixelsPerInchHorizontal := GetDeviceCaps( Printer.Handle,LOGPIXELSX );
{ Get the gutter on the left and top. 'Escape' is a Windows API
call. }
Escape( Printer.Canvas.Handle,GETPRINTINGOFFSET,0,Nil,@pt );
GutterLeft := pt.X;
GutterTop := pt.Y;
Escape( Printer.Canvas.Handle,GETPHYSPAGESIZE,0,Nil,@pt );
TotalPageWidthPixels := pt.X;
TotalPageHeightPixels := pt.Y;
TotalPageWidthInches := pt.X / PixelsPerInchHorizontal;
TotalPageHeightInches := pt.Y / PixelsPerInchVertical;
GutterRight := TotalPageWidthPixels - GutterLeft - Printer.PageWidth;
GutterBottom := TotalPageHeightPixels - GutterTop - Printer.PageHeight;
If ( TopMargin < GutterTop ) Then
TopMargin := GutterTop;
If ( BottomMargin < GutterBottom ) Then
BottomMargin := GutterBottom;
If ( LeftMargin < GutterLeft ) Then
LeftMargin := GutterLeft;
If ( RightMargin < GutterRight ) Then
RightMargin := GutterRight;
End;
procedure TPrintObject.SetHeaderInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word;
FontName:String; FontSize: Word; FontStyle: TFontStyles );
Begin
If ( Line > HeaderLines ) Then
Exit;
Header[Line].Text := Text;
Header[Line].YPosition := YPosition;
Header[Line].Alignment := Alignment;
Header[Line].FontName := FontName;
Header[Line].FontSize := FontSize;
Header[Line].FontStyle := FontStyle;
End;
procedure TPrintObject.SetFooterInformation( Line:Integer; YPosition: Single; Text:String; Alignment:Word;
FontName:String; FontSize: Word; FontStyle: TFontStyles );
Begin
If ( Line > FooterLines ) Then
Exit;
Footer[Line].Text := Text;
Footer[Line].YPosition := YPosition;
Footer[Line].Alignment := Alignment;
Footer[Line].FontName := FontName;
Footer[Line].FontSize := FontSize;
Footer[Line].FontStyle := FontStyle;
End;
procedure TPrintObject.WriteHeader;
{ If any headers are defined, write them }
var
I: Integer;
Begin
SaveCurrentFont;
For I := 1 To HeaderLines Do
Begin
If ( Length(Header[I].Text) > 0 ) Then
Begin
With Header[I] Do
Begin
SetFontInformation( FontName,FontSize,FontStyle );
If ( Alignment = 0 ) Then
WriteLine( LeftMargin, YPosition, Text );
If ( Alignment = 1 ) Then
WriteLineCenter( YPosition, Text );
If ( Alignment = 2 ) Then
WriteLineRight( YPosition, Text );
End;
End;
RestoreCurrentFont;
End;
{ Does the user desire a box around the header? }
If ( HeaderCoordinates.Boxed = True ) Then
Begin
If ( HeaderCoordinates.Shading > 0 ) Then
DrawBoxShaded( HeaderCoordinates.XTop,HeaderCoordinates.YTop,HeaderCoordinates.XBottom,
HeaderCoordinates.YBottom,HeaderCoordinates.LineWidth,HeaderCoordinates.Shading )
Else
DrawBox( HeaderCoordinates.XTop,HeaderCoordinates.YTop,HeaderCoordinates.XBottom,
HeaderCoordinates.YBottom,HeaderCoordinates.LineWidth );
End;
End;
procedure TPrintObject.WriteFooter;
{ If any footers are defined, write them }
var
I: Integer;
Temp: Boolean;
Begin
SaveCurrentFont;
{ Set 'AutoPaging' off. Otherwise the footer will not get written
correctly. }
Temp := AutoPaging;
AutoPaging := False;
For I := 1 To FooterLines Do
Begin
If ( Length(Footer[I].Text) > 0 ) Then
Begin
With Footer[I] Do
Begin
SetFontInformation( FontName,FontSize,FontStyle );
If ( Alignment = 0 ) Then
WriteLine( LeftMargin, YPosition, Text );
If ( Alignment = 1 ) Then
WriteLineCenter( YPosition, Text );
If ( Alignment = 2 ) Then
WriteLineRight( YPosition, Text );
End;
End;
RestoreCurrentFont;
End;
{ Does the user desire a box around the footer? }
If ( FooterCoordinates.Boxed = True ) Then
Begin
If ( FooterCoordinates.Shading > 0 ) Then
DrawBoxShaded( FooterCoordinates.XTop,FooterCoordinates.YTop,FooterCoordinates.XBottom,
FooterCoordinates.YBottom,FooterCoordinates.LineWidth,FooterCoordinates.Shading )
Else
DrawBox( FooterCoordinates.XTop,FooterCoordinates.YTop,FooterCoordinates.XBottom,
FooterCoordinates.YBottom,FooterCoordinates.LineWidth );
End;
AutoPaging := Temp;
End;
procedure TPrintObject.SaveCurrentFont;
Begin
CurrentFontName := Printer.Canvas.Font.Name;
CurrentFontSize := Printer.Canvas.Font.Size;
CurrentFontStyle := Printer.Canvas.Font.Style;
End;
procedure TPrintObject.RestoreCurrentFont;
Begin
SetFontInformation( CurrentFontName,CurrentFontSize,CurrentFontStyle );
End;
procedure TPrintObject.SetDetailTopBottom( Top: Single; Bottom: Single );
Begin
DetailTop := Top;
DetailBottom := Bottom;
LastYPosition := Top - GetLineHeightInches;
End;
procedure TPrintObject.SetAutoPaging( Value: Boolean );
Begin
AutoPaging := Value;
End;
procedure TPrintObject.SetPageNumberInformation( YPosition:Single; Text:String; Alignment:Word; FontName:String;
FontSize:Word; FontStyle:TFontStyles );
Begin
PageNumber.Text := Text;
PageNumber.YPosition := YPosition;
PageNumber.Alignment := Alignment;
PageNumber.FontName := FontName;
PageNumber.FontSize := FontSize;
PageNumber.FontStyle := FontStyle;
End;
procedure TPrintObject.WritePageNumber;
var
Buffer: String;
Temp: Boolean;
Begin
Buffer := Format( PageNumber.Text,[Printer.PageNumber] );
SaveCurrentFont;
SetFontInformation( PageNumber.FontName,PageNumber.FontSize,PageNumber.FontStyle );
Temp := AutoPaging;
AutoPaging := False;
If ( PageNumber.Alignment = 0 ) Then
WriteLine( LeftMargin, PageNumber.YPosition, Buffer );
If ( PageNumber.Alignment = 1 ) Then
WriteLineCenter( PageNumber.YPosition, Buffer );
If ( PageNumber.Alignment = 2 ) Then
WriteLineRight( PageNumber.YPosition, Buffer );
AutoPaging := Temp;
RestoreCurrentFont;
End;
procedure TPrintObject.SetTab( Inches:Single );
Begin
CurrentTab := Inches;
End;
procedure TPrintObject.SetHeaderDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
Boxed: Boolean; LineWidth:Word; Shading:Word );
Begin
HeaderCoordinates.XTop := XTop;
HeaderCoordinates.XBottom := XBottom;
HeaderCoordinates.YTop := YTop;
HeaderCoordinates.YBottom := YBottom;
HeaderCoordinates.Boxed := Boxed;
HeaderCoordinates.LineWidth := LineWidth;
HeaderCoordinates.Shading := Shading;
End;
procedure TPrintObject.SetFooterDimensions( XTop:Single; YTop:Single; XBottom:Single; YBottom:Single;
Boxed: Boolean; LineWidth:Word; Shading:Word );
Begin
FooterCoordinates.XTop := XTop;
FooterCoordinates.XBottom := XBottom;
FooterCoordinates.YTop := YTop;
FooterCoordinates.YBottom := YBottom;
FooterCoordinates.Boxed := Boxed;
FooterCoordinates.LineWidth := LineWidth;
FooterCoordinates.Shading := Shading;
End;
procedure TPrintObject.CreateColumn( Number:Word; XPosition:Single; Length:Single );
Begin
ColumnInformation[Number].XPosition := XPosition;
ColumnInformation[Number].Length := Length;
End;
procedure TPrintObject.SetYPosition( YPosition:Single );
Begin
LastYPosition := YPosition;
End;
function TPrintObject.GetYPosition: Single;
Begin
Result := LastYPosition;
End;
procedure TPrintObject.NextLine;
Begin
LastYPosition := LastYPosition + GetLineHeightInches;
End;
function TPrintObject.GetLinesLeft: Word;
{ Return the number of lines left in the detail area }
var
Lines: Single;
Buffer: String[20];
I: Word;
Begin
Lines := (DetailBottom - LastYPosition) / GetLineHeightInches;
Buffer := FloatToStr( Lines );
{ Buffer contains the number of lines left as a floating point number.
Find the decimal and truncate the string at that point. So, if there
are 2.99 lines left, 2 will be returned. Better to be conservative. }
For I := 1 To Length(Buffer) Do
Begin
If ( Buffer[I] = '.' ) Then
Begin
Buffer[0] := Chr(I-1);
Break;
End;
End;
Result := StrToInt( Buffer );
End;
procedure TPrintObject.SetTopOfPage;
Begin
LastYPosition := DetailTop;
End;
procedure TPrintObject.NewLines( Number:Word );
{ Generate the number of line feeds represented in 'Number' }
var
I: Word;
Begin
For I := 1 To Number Do
NextLine;
End;
end.